home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / cmln0185.arc / MENUSYS.PRG < prev   
Text File  |  1986-02-27  |  4KB  |  138 lines
  1. * MENUSYS.PRG -- by Darryl Rubin, November, 1984.
  2. *
  3. * For more information about this program, see COMPUTER LANGUAGE
  4. * MAGAZINE, January, 1985.
  5. *
  6. * This program implements an interactive menu system.  It presents
  7. * a menu from a specified .DBF file and allows you to move a
  8. * highlighted selection bar using F3 (up), F4 (down), or an
  9. * alphanumeric key (first character of the desired menu item).  Hitting
  10. * F1 or Enter will select the currently highlighted item and F2 will
  11. * quit the menu.
  12. *
  13. * Menu files have the structure ITEM (C 38), HELP (C 40), COMMAND (C 80),
  14. * and may have up to 23 records:  one for each screen row from 1 to 23.
  15. * ITEMs are displayed on the screen one per line starting at column
  16. * 20, with HELP text for the currently selected item on line 25.
  17. * When a given item is selected, the COMMAND field is executed as
  18. * a macro.
  19. *
  20. * The COMMAND field can contain any command you could type at the
  21. * dot prompt, including another DO MENU command (however, the COMMAND
  22. * may not contain macros).  Because the menu system is recursive, it's
  23. * OK for menus to call other menus.  You can also provide a menu item
  24. * for quitting the menu if you want an alternative to F2; just
  25. * specify a COMMAND of RETURN.
  26. *
  27. * Records with blank COMMAND fields are treated as menu titles.  The
  28. * selection bar automatically skips over these items -- they are
  29. * not selectable.
  30. *
  31. * The menu system consists of two procedures:  DRAWMENU.PRG and MENU.PRG.
  32. * To start the system, type the following commands, where <MENUNAME>
  33. * is the file name (sans extension) of the desired MENU database.
  34. *
  35. *   SET PROCEDURE TO MENUSYS.PRG
  36. *   DO MENU WITH <MENUNAME>
  37. *
  38. * The menu system will run faster if you delete all the comments.
  39. *
  40. procedure drawmenu
  41. *
  42. * Draws the menu screen
  43. *
  44.   use &menufile
  45.   set talk off
  46.   set exact on
  47.   set filter to
  48.   goto top
  49.   clear
  50.   do while .not. eof() .and. recno() <= 23
  51.     @recno()-1,20 say trim(item)
  52.     skip
  53.   enddo
  54.   set filter to trim(command) <> ''
  55. return
  56. *
  57. procedure menu
  58. *
  59. * Main routine and MENUSYS entry point
  60. *
  61.   parameters menufile
  62.   private first, last, exec, lastpos
  63.   do drawmenu
  64. *1: Determine screen rows of first and last selectable items
  65.   goto bottom
  66.   do while recno() > 23
  67.     skip -1
  68.   enddo
  69.   last = recno()
  70.   goto top
  71.   first = recno()
  72.   key = chr(255)
  73.   do while key <> chr(254)
  74. *2: Highlight the currently selected item and get next keystroke
  75.     @recno()-1,20
  76.     selectn = trim(item)
  77.     set color to 7+
  78.     @recno()-1,20 say selectn
  79.     @24,0
  80.     @24,(80-len(trim(help)))/2 say help
  81.     set color to 7
  82.     set console off
  83.     wait to key
  84.     set console on
  85.     @recno()-1,20
  86.     @recno()-1,20 say item
  87.     @24,0
  88.     do case
  89.       case key = chr(252)
  90. *3: User hit F4.  Select next item.
  91.         if recno() < last
  92.           skip 1
  93.           if recno() > last
  94.             goto first
  95.           endif
  96.         else
  97.           goto first
  98.         endif
  99.       case key = chr(253)
  100. *4: User hit F3.  Select previous item.
  101.         if recno() > first
  102.           skip -1
  103.           if recno() < first
  104.             goto last
  105.           endif
  106.         else
  107.           goto last
  108.         endif
  109.       case len(key) = 0
  110. *5: User hit enter or other extended key.  Exec the COMMAND field.
  111.         clear
  112.         exec = command
  113.         lastpos = recno()
  114.         set exact off
  115.         &exec
  116. *6: We're back, now pause if not returning from another menu.
  117.         if .not. upper(trim(substr(exec,1,8))) $ 'DO MENU HELPASSIST'
  118.           ?
  119.           wait to key
  120.         endif
  121.         do drawmenu
  122.         goto lastpos
  123.         key = ' '
  124.       otherwise
  125. *7: User hit some other key, skip to matching menu item, if any
  126.         lastpos = recno()
  127.         locate for substr(item,1,1) = key
  128.         if eof()
  129.           goto lastpos
  130.         endif
  131.     endcase
  132.   enddo
  133. *8: All done, restore settings and quit
  134.   clear
  135.   set exact off
  136.   set talk on
  137. return
  138.